home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro15 / arty.bas < prev    next >
BASIC Source File  |  1990-08-20  |  4KB  |  169 lines
  1.  '******************************************************************************
  2.  '* ARTY - Symetrical line drawing demo.                                       *
  3.  '*                                                                            *
  4.  '* Written for GRAFIX by:  Joseph A. Albrecht                                 *
  5.  '*                                                                            *
  6.  '* Press F1 to pause program                                                  *
  7.  '* Press F2 to redraw image                                                   *
  8.  '* Press F10 to toggle between 320 and 640 graphics modes                     *
  9.  '* Press ESC to exit program                                                  *
  10.  '******************************************************************************
  11.  '$INCLUDE: 'GRAFQBS.INC'
  12.  'The above line is for QuickBASIC.
  13.  
  14.  ''$INCLUDE "GRAFTBS.INC"
  15.  'The above line is for TURBO BASIC. Remove the  ''  to compile the program.
  16.  
  17.  ''$INCLUDE "GRAFPBS.INC"
  18.  'The above line is for PowerBASIC. Remove the  ''  to compile the program.
  19.  
  20.  Lines = 100
  21.  DIM LX1(Lines), LY1(Lines), LX2(Lines), LY2(Lines)
  22.  Graphics = 320
  23.  MaxColor = 15
  24.  CALL GetTandy11(Tandy11%)
  25.  CALL MediumGraphics
  26.  
  27. MainLoop:
  28.  GOSUB Initialize
  29.  DO
  30.    GOSUB EraseCurrentLine
  31.    IF ColorCount = 0 THEN GOSUB SelectNewColors
  32.    IF IncrementCount = 0 THEN GOSUB SelectNewDeltaValues
  33.    GOSUB AdjustX1
  34.    GOSUB AdjustY1
  35.    GOSUB AdjustX2
  36.    GOSUB AdjustY2
  37.    IF INT(RND * 5) = 3 THEN
  38.      X1 = (X1 + X2) \ 2
  39.      Y2 = (Y1 + Y2) \ 2
  40.    END IF
  41.    GOSUB DrawCurrentLine
  42.    GOSUB UpdateLine
  43.    K$ = INKEY$
  44.    K$ = RIGHT$(K$, 1)
  45.    IF K$ = CHR$(27) THEN
  46.      CALL ExitGraphics
  47.      END
  48.    END IF
  49.    IF K$ = CHR$(59) THEN CALL WaitKey
  50.    IF K$ = CHR$(60) THEN GOSUB Initialize
  51.    IF K$ = CHR$(68) AND Tandy11% = Tandy11.True% THEN
  52.      IF Graphics = 320 THEN
  53.        Graphics = 640
  54.        CALL HighGraphics
  55.        GOSUB Initialize
  56.      ELSE
  57.        Graphics = 320
  58.        CALL MediumGraphics
  59.        GOSUB Initialize
  60.      END IF
  61.    END IF
  62.  LOOP
  63.  
  64. Initialize:
  65.  CALL ClearScreen
  66.  RANDOMIZE TIMER
  67.  IF Graphics = 320 THEN
  68.    MaxX = 319
  69.    MaxDelta = 7
  70.  ELSE
  71.    MaxX = 639
  72.    MaxDelta = 9
  73.  END IF
  74.  MaxY = 199
  75.  L = 1
  76.  IncrementCount = 0
  77.  StartX = MaxX \ 2
  78.  StartY = MaxY \ 2
  79.  FOR I = 1 TO Lines
  80.    LX1(I) = StartX
  81.    LY1(I) = StartY
  82.    LX2(I) = StartX
  83.    LY2(I) = StartY
  84.  NEXT I
  85.  X1 = StartX
  86.  Y1 = StartY
  87.  X2 = StartX
  88.  Y2 = StartY
  89.  GOSUB SelectNewColors
  90.  RETURN
  91.  
  92. AdjustX1:
  93.  TestX1 = DeltaX1 + X1
  94.  IF (TestX1 < 1) OR (TestX1 > MaxX) THEN
  95.    TestX1 = X1
  96.    DeltaX1 = -DeltaX1
  97.  END IF
  98.  X1 = TestX1
  99.  RETURN
  100.  
  101. AdjustY1:
  102.  TestY1 = DeltaY1 + Y1
  103.  IF (TestY1 < 1) OR (TestY1 > MaxY) THEN
  104.    TestY1 = Y1
  105.    DeltaY1 = -DeltaY1
  106.  END IF
  107.  Y1 = TestY1
  108.  RETURN
  109.  
  110. AdjustX2:
  111.  TestX2 = DeltaX2 + X2
  112.  IF (TestX2 < 1) OR (TestX2 > MaxX) THEN
  113.    TestX2 = X2
  114.    DeltaX2 = -DeltaX2
  115.  END IF
  116.  X2 = TestX2
  117.  RETURN
  118.  
  119. AdjustY2:
  120.  TestY2 = DeltaY2 + Y2
  121.  IF (TestY2 < 1) OR (TestY2 > MaxY) THEN
  122.    TestY2 = Y2
  123.    DeltaY2 = -DeltaY2
  124.  END IF
  125.  Y2 = TestY2
  126.  RETURN
  127.  
  128. SelectNewColors:
  129.  C1 = INT(RND * MaxColor + 1)
  130.  C2 = INT(RND * MaxColor + 1)
  131.  C3 = INT(RND * MaxColor + 1)
  132.  C4 = INT(RND * MaxColor + 1)
  133.  ColorCount = INT(RND * 5 + 1) * 3
  134.  RETURN
  135.  
  136. SelectNewDeltaValues:
  137.  DeltaX1 = INT(RND * MaxDelta) - (MaxDelta \ 2)
  138.  DeltaY1 = INT(RND * MaxDelta) - (MaxDelta \ 2)
  139.  DeltaX2 = INT(RND * MaxDelta) - (MaxDelta \ 2)
  140.  DeltaY2 = INT(RND * MaxDelta) - (MaxDelta \ 2)
  141.  IncrementCount = INT(RND * 4 + 1) * 2
  142.  RETURN
  143.  
  144. UpdateLine:
  145.  L = L + 1
  146.  IF L > Lines THEN L = 1
  147.  ColorCount = ColorCount - 1
  148.  IncrementCount = IncrementCount - 1
  149.  RETURN
  150.  
  151. DrawCurrentLine:
  152.  CALL ExtLineC(X1, Y1, X2, Y2, C1)
  153.  CALL ExtLineC(MaxX - X1, Y1, MaxX - X2, Y2, C2)
  154.  CALL ExtLineC(X1, MaxY - Y1, X2, MaxY - Y2, C3)
  155.  CALL ExtLineC(MaxX - X1, MaxY - Y1, MaxX - X2, MaxY - Y2, C4)
  156.  RETURN
  157.  
  158. EraseCurrentLine:
  159.  CALL ExtLineC(LX1(L), LY1(L), LX2(L), LY2(L), 0)
  160.  CALL ExtLineC(MaxX - LX1(L), LY1(L), MaxX - LX2(L), LY2(L), 0)
  161.  CALL ExtLineC(LX1(L), MaxY - LY1(L), LX2(L), MaxY - LY2(L), 0)
  162.  CALL ExtLineC(MaxX - LX1(L), MaxY - LY1(L), MaxX - LX2(L), MaxY - LY2(L), 0)
  163.  LX1(L) = X1
  164.  LY1(L) = Y1
  165.  LX2(L) = X2
  166.  LY2(L) = Y2
  167.  RETURN
  168.  
  169.